;;;   RECTANG.lsp
;;;   Copyright (C) 1990 by Autodesk, Inc.
;;;  
;;;   Permission to use, copy, modify, and distribute this software and its
;;;   documentation for any purpose and without fee is hereby granted.  
;;;
;;;   THIS SOFTWARE IS PROVIDED "AS IS" WITHOUT EXPRESS OR IMPLIED WARRANTY. 
;;;   ALL IMPLIED WARRANTIES OF FITNESS FOR ANY PARTICULAR PURPOSE AND OF 
;;;   MERCHANTABILITY ARE HEREBY DISCLAIMED.
;;; 
;;;   by Amy Berger
;;;   April, 1990
;;;
;;;--------------------------------------------------------------------------
;;; DESCRIPTION
;;;
;;;   RECTANG.LSP
;;; 
;;;   This lisp routine creates a 2d square or rectangle in the currect ucs.      ;;;   
;;;
;;;
;;;--------------------------------------------------------------------------


(defun myerror (s)                    ; If an error (such as CTRL-C) occurs
                                      ; while this command is active...
  (if (/= s "Function cancelled")
    (princ (strcat "\nError: " s))
  )
  (setvar "cmdecho" ocmd)             ; Restore saved modes
  (setvar "blipmode" oblp)
  (setq *error* olderr)               ; Restore old *error* handler
  (princ)
)

(defun c:rectang (/ olderr ocmd oblp pt1 pt2 pt3 pt4 l w)
  (setq olderr  *error*
        *error* myerror)
  (setq ocmd (getvar "cmdecho"))
  (setq oblp (getvar "blipmode"))
  (setvar "cmdecho" 0)
  (initget 1)                         ;3D point can't be null
  (setq pt1 (getpoint (strcat "\nCorner of rectangle or square: ")))
  (setvar "ORTHOMODE" 1)
  (initget 7)                         ;Length can't be 0, neg, or null
  (setq l (getdist pt1 "\nLength: "))
  (setq pt2 (list (+ (car pt1) l) (cadr pt1) (caddr pt1)))
  (grdraw pt1 pt2 2)
  (initget 7 "Square")                ;Width can't be 0, neg, or null
  (setq w (getdist pt1 "\nSquare/<Width>: "))
  (if (= w "Square") 
      (setq w l)
  )
  (setq pt3 (list (car pt2) (+ (cadr pt2) w) (caddr pt2)))
  (setq pt4 (list (car pt1) (+ (cadr pt1) w) (caddr pt1)))
  (grdraw pt2 pt3 2)
  (grdraw pt3 pt4 2)
  (grdraw pt4 pt1 2)
  (setvar "ORTHOMODE" 0)
  (command "pline" pt1 pt2 pt3 pt4 "close")
  (prompt "\nRotation angle: ")
  (command "rotate" "l" "" pt1 pause)
  (setvar "cmdecho" ocmd)
  (setvar "blipmode" oblp)
  (setq *error* olderr)               ; Restore old *error* handler
  (princ)
)

(defun c:rect() (c:rectang))
(princ "\n\tC:RECTANG loaded.  Start command with RECT or RECTANG.")
(princ)
